home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Book / randomwalk.lsp < prev    next >
Text File  |  1990-10-11  |  1KB  |  46 lines
  1. ; book pp.252-253
  2.  
  3. (load "book/resize")
  4.  
  5. (send w :add-slot 'step-size 10)
  6.  
  7. (defmeth w :step-size (&optional (val nil set))
  8.   (if set (setf (slot-value 'step-size) val))
  9.   (slot-value 'step-size))
  10.  
  11. (defmeth w :move (x y)
  12.   (send self :x (+ x (send self :x)))
  13.   (send self :y (+ y (send self :y)))
  14.   (send self :redraw))
  15.  
  16. (defmeth w :do-idle ()
  17.   (let ((step (send self :step-size)))
  18.     (case (random 4)
  19.       (0 (send self :move 0 (- step)))
  20.       (1 (send self :move 0 step))
  21.       (2 (send self :move step 0))
  22.       (3 (send self :move (- step) 0)))))
  23.  
  24. (send w :idle-on t)
  25.  
  26. (defmeth w :restart ()
  27.   (send self :x (/ (send self :canvas-width) 2))
  28.   (send self :y (/ (send self :canvas-height) 2))
  29.   (send self :redraw))
  30.  
  31. (setf restart-item
  32.   (send menu-item-proto :new "Restart"
  33.       :action #'(lambda () (send w :restart))))
  34.  
  35. (setf run-item
  36.   (send menu-item-proto :new "Run"
  37.       :action #'(lambda () (send w :idle-on (not (send w :idle-on))))))
  38.  
  39. (defmeth run-item :update ()
  40.   (send self :mark (send w :idle-on)))
  41.  
  42. (setf menu (send menu-proto :new "Random Walk"))
  43. (send menu :append-items restart-item run-item)
  44. (send w :menu menu)
  45. (send menu :install)
  46.